home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / tictac.com / TICTAC.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1989-05-25  |  12.3 KB  |  489 lines
  1. Program Tic_Tac_Toe;
  2.  
  3. Uses Dos,Graph,Crt;
  4.  
  5. {Beta version of TicTacToe Game by Robert H Snow
  6.  Used as a starting point for Reasearch Into
  7.  Artifical Intelligence by SCT.  It Is Very
  8.  Crude and uses a very simple way of trying to win
  9.  It Store all moves in a winning game and how many
  10.  times it has won then on a given move tries
  11.  several different possible moves and picks the
  12.  one that has won the most games. after several
  13.  thousand Games It is intersting to look at the
  14.  Ticmem file.
  15.  This Program works without ever knowing any of
  16.  the rules of how to win ie, No hardwired responses.
  17.  It also plays only player2.  If you want to make
  18.  your own tictactoe game several of the routines
  19.  will be useful to you like Open, RandMove, and
  20.  Winner.  Note: try changing the winning combonations
  21.  in Winner and this will still learn what wins, ie: Four Corners}
  22.  
  23.  {Tic Tac Toe by Robert Snow, CIS 76136,1553}
  24.  
  25.  
  26.  
  27. Const
  28.   Games = 1024; {How Many Games to play this session}
  29.   TotalGameMemory = 256; {How Much Memory do I use 128-256 seem to be best}
  30.   FileName = 'c:\pascal\prog\ticmem.'; {FileName for Memory File}
  31.   GStep = (Games div 200) + 1;
  32.   BarStep = Games div 16;
  33.   XOffset = 30; {Where to put the board on the Screen X-Axis}
  34.   YOffset = 40; {Where to put board on Screen Y-Axis}
  35.   SortStep = 128; {How often to sort memory}
  36.   PurgeBefore = 1024; {Keep only games that have won in the last # of games}
  37.   MaxX = 320; {Currently Set for CGA}
  38.   MaxY = 200; {Currently Set for CGA}
  39.  
  40. Type
  41.   Board = Array[1..3, 1..3] of 0..2;
  42.   GameMem = Array[1..TotalGameMemory] of Board;
  43.  
  44. Var
  45.   GameMemory, CurrentGameMemory: GameMem;
  46.   CurrentBoard,Test,LastBoard:   Board;
  47.   FileString:                    String;
  48.   Wins:                          Array[1..TotalGameMemory] of Integer;
  49.   LastWin:                       Array[1..TotalGameMemory] of Word;
  50.   Turn,Player,CTest,
  51.   GameCount,tr1,tr2,
  52.   Winner1,Winner2,
  53.   MostWins,MoveNum,
  54.   Num,TimesWon,Hr,Min,EHr,Emin,sec,sec100:Word;
  55.   Checker:                       Byte;
  56.   InMem:                         Boolean;
  57.   TotalGames,Count:              Word;
  58.   Ph,Pm:                         Integer;
  59.  
  60.  
  61. Procedure DrawField;
  62. Var GD,GM: Integer;
  63. Begin
  64.  GD:=Detect;
  65.  InitGraph(GD,GM,'');
  66.  SetFillStyle(SolidFill,Blue);
  67.  SetColor(Black);
  68.  Bar3D(105+XOffSet,5+YOffSet,111+XOffSet,150+YOffSet,0,TopOff);
  69.  Bar3D(160+XOffSet,5+YOffSet,166+XOffSet,150+YOffSet,0,TopOff);
  70.  Bar3d(055+XOffSet,50+YOffSet,215+XOffSet,56+YOffSet,0,TopOff);
  71.  Bar3d(055+XOffSet,100+YOffSet,215+XOffSet,106+YOffSet,0,TopOff);
  72.  SetTextStyle(TriplexFont,1,4);
  73.  SetTextJustify(CenterText,CenterText);
  74.  SetColor(Magenta);
  75.  OutTextXY(MaxX-30,MaxY-125,'The Student 1.0');
  76.  SetColor(Red);
  77.  Rectangle(1,MaxY-1,10,MaxY-(Games div GStep));
  78.  SetColor(Red);
  79.  Rectangle(0,MaxY,11,(MaxY-3)-(Games div GStep)+1);
  80.  SetTextStyle(SmallFont,0,4);
  81.  SetColor(Yellow);
  82.  OutTextXY(27,MaxY-7,'Start');
  83.  OutTextXY(30,(MaxY+3)-(Games div GStep),'Finish');
  84.  SetTextStyle(TriplexFont,0,6);
  85. End;
  86.  
  87.  
  88. Procedure Init;
  89. var x,y: Word;
  90. begin
  91.  for x:=1 to 3 do
  92.   for y:=1 to 3 do
  93.    CurrentBoard[x,y]:=0;
  94. end;
  95.  
  96. Procedure FileIt(GMem: GameMem);
  97. Var
  98.  Count,x,y: Word;
  99.  f:         Text;
  100. Begin
  101.  Assign(f, FileString);
  102.  Rewrite(f);
  103.  For Count:=1 to TotalGameMemory Do Begin
  104.    For x:=1 to 3 do Begin
  105.     For y:=1 to 3 do
  106.      Write(f, (GMem[Count,x,y]):4);
  107.     Writeln(f);
  108.    End;
  109.    Writeln(f, Wins[Count]);
  110.    Writeln(f, LastWin[Count]);
  111.    Writeln(f);
  112.   End;
  113.  Writeln(f, Winner1);
  114.  Writeln(f, Winner2);
  115.  Writeln(f, (TotalGames + GameCount));
  116.  Close(f)
  117. End;
  118.  
  119. Procedure ReadMemory(Var GMem: GameMem);
  120. Var
  121.  Count,x,y:   Word;
  122.  Sv:          String[4];
  123.  SvBig:       String[6];
  124.  f:           Text;
  125.  c:           Integer;
  126.  
  127. Begin
  128.  Assign(f, FileString);
  129.  Reset(f);
  130.  For Count:=1 to TotalGameMemory Do Begin
  131.   For x:=1 to 3 Do Begin
  132.    For y:=1 to 3 Do Begin
  133.     Read(f, Sv);
  134.     Val(Sv, GMem[Count,x,y],c)
  135.    End;
  136.    Readln(f);
  137.   End;
  138.   Readln(f, SvBig);
  139.   Val(SvBig, Wins[Count],c);
  140.   Readln(f, SvBig);
  141.   Val(SvBig, LastWin[Count],c);
  142.   Readln(f)
  143.  End;
  144.  Readln(f, SvBig);
  145.  Val(SvBig, Winner1, c);
  146.  Readln(f, SvBig);
  147.  Val(SvBig, Winner2, c);
  148.  Readln(f, SvBig);
  149.  Val(SvBig, TotalGames, c);
  150.  Close(f)
  151. End;
  152.  
  153.  
  154.  
  155. Function Open(var game: board): Boolean;
  156. var
  157.   x,y: Word;
  158. begin
  159.   Open:= false;
  160.   for x:=1 to 3 do
  161.    for y:=1 to 3 do
  162.     if game[x,y]=0 then Open:= true
  163. end;
  164.  
  165. Procedure RandMove(player: Word; Var CBoard: Board);
  166. var
  167.   x,y: Word;
  168. begin
  169.    repeat
  170.     x:= random(3)+1;
  171.     y:= random(3)+1;
  172.    until CBoard[x, y] = 0;
  173.    CBoard[x,y]:= Player
  174. end;
  175.  
  176. Procedure ClearMem(CMem: GameMem);
  177. var i,x,y:Word;
  178. begin
  179.  for i:=1 to TotalGameMemory do
  180.   begin
  181.   for x:=1 to 3 do
  182.    for y:=1 to 3 do
  183.     CMem[i,x,y]:=0;
  184.   end
  185. end;
  186.  
  187.  
  188. Function Winner(CGame: Board): Integer;
  189. var
  190.   x,y,Player: Word;
  191. begin
  192.  Winner:=0;
  193.  for player:=1 to 2 do
  194.   begin
  195.    for x:=1 to 3 do
  196.     if (CGame[x,1]=player) and (CGame[x,2]=player) and (CGame[x,3]=player) then
  197.      Winner:= player;
  198.    for y:=1 to 3 do
  199.     if (CGame[1,y]=player) and (CGame[2,y]=player) and (CGame[3,y]=player) then
  200.      Winner:= player;
  201.    if (CGame[1,1]=player) and (CGame[2,2]=player) and (CGame[3,3]=player) then
  202.     Winner:= player;
  203.    if (CGame[3,1]=player) and (CGame[2,2]=player) and (CGame[1,3]=player) then
  204.     Winner:= player
  205.   end
  206. end;
  207.  
  208. Procedure DrawBoard(CB,OB: Board);
  209. Var X,Y: Byte;
  210. Begin
  211.  SetColor(Black);
  212.  For X:=1 to 3 do
  213.   For Y:=1 to 3 do Begin
  214.    Case OB[x,y] of
  215.     1: OutTextXY(((x*55)+25+XOffSet),((y*50)+(YOffSet-27)), 'O');
  216.     2: OutTextXY(((x*55)+25+XOffSet),((y*50)+(YOffSet-27)),'X')
  217.    End
  218.   End;
  219.  SetColor(Yellow);
  220.  For X:=1 to 3 do
  221.   For Y:=1 to 3 do Begin
  222.    Case CB[x,y] of
  223.     1: OutTextXY(((x*55)+25+XOffSet),((y*50)+(YOffSet-27)),'O');
  224.     2: OutTextXY(((x*55)+25+XOffSet),((y*50)+(YOffSet-27)),'X')
  225.    End
  226.   End
  227. End;
  228.  
  229.  
  230. Procedure Store(Game: Board; Turn: Integer);
  231. begin
  232.  CurrentGameMemory[turn]:=Game;
  233. end;
  234.  
  235. Procedure SortMem(Var GMem: GameMem);
  236. Var Changed:     Boolean;
  237.     Count:       Integer;
  238.     Temp:        Board;
  239.     WinsTemp:    Integer;
  240.  
  241. Begin
  242.  Repeat
  243.   Changed:=False;
  244.   For Count:=1 to TotalGameMemory-1 Do
  245.    If (Wins[Count+1]>Wins[Count]) then Begin
  246.     Temp:=GMem[Count+1];
  247.     GMem[Count+1]:=GMem[Count];
  248.     GMem[Count]:=Temp;
  249.     WinsTemp:=Wins[Count+1];
  250.     Wins[Count+1]:=Wins[Count];
  251.     Wins[Count]:=WinsTemp;
  252.     Changed:=True
  253.    End;
  254.  Until (Not Changed)
  255. End;
  256.  
  257.  
  258.  
  259.  
  260. Procedure Memry(Last: GameMem; turns: Integer; Val: Integer);
  261. var
  262.  gturn,Count,x,y:  Word;
  263.  found:   Boolean;
  264.  
  265.  Function Match(GameMemory, Last: GameMem): Boolean;
  266.  var TempX,TempY,x,y: Word;
  267.      Match1, Match2, Match3, Match4:  Boolean;
  268.  begin
  269.   Match:=True;
  270.   Match1:=True;
  271.   Match2:=True;
  272.   Match3:=True;
  273.   Match4:=True;
  274.     For x:=1 to 3 do
  275.      For y:=1 to 3 do Begin
  276.       TempX:=x;TempY:=y;
  277.       if Last[gturn,x,y] <> GameMemory[Count,TempX,TempY] then Match1:=False;
  278.       IF x=1 then TempX:=3;
  279.       IF x=3 then TempX:=1;
  280.       IF Last[gturn,x,y] <> GameMemory[Count,TempX,TempY] then Match2:=False;
  281.       IF y=1 then TempY:=3;
  282.       IF y=3 then TempY:=1;
  283.       IF Last[gturn,x,y] <> GameMemory[Count,TempX,TempY] then Match3:=False;
  284.       TempX:=x;
  285.       IF Last[gturn,x,y] <> GameMemory[Count,TempX,TempY] then Match4:=False;
  286.   End;
  287.   If (Not Match1) and (Not Match2) and (Not Match3) and (Not Match4) then
  288.    Match:=False
  289.  end;
  290.  
  291. begin
  292.  for gturn:=1 to turns do
  293.  begin
  294.   found:= false;
  295.   Count:=1;
  296.   Repeat
  297.    IF match(GameMemory, Last) then
  298.     begin
  299.      Wins[Count]:=Wins[Count]+Val;
  300.      If Val=1 Then LastWin[Count]:=GameCount + TotalGames;
  301.      found:= true
  302.     end;
  303.    Count:=Count+1
  304.   Until ((Count-1)=TotalGameMemory) or Found;
  305.   If ((not found) and (val=1)) then
  306.    Begin
  307.     Found:=false;
  308.     Count:=1;
  309.     Repeat
  310.      If (Wins[Count]<1) then
  311.        Begin
  312.         Found:=True;
  313.         GameMemory[Count]:=Last[gturn];
  314.         Wins[Count]:=1;
  315.         LastWin[Count]:= GameCount + TotalGames;
  316.        end;
  317.     Count:=Count+1;
  318.     Until ((Count-1)=TotalGameMemory) or Found
  319.    end
  320.  end;
  321. end;
  322.  
  323. Procedure Purge(GMem: GameMem);
  324. var count:            Word;
  325. Begin
  326.  For Count:=1 to TotalGameMemory Do
  327.   If LastWin[Count]<((TotalGames+GameCount)-(PurgeBefore)) Then
  328.    Wins[Count]:=0;
  329. End;
  330.  
  331. Procedure DumpMem(GameMemory: GameMem);
  332. var Count,x,y:  Word;
  333. begin
  334.   FOR Count:=TotalGameMemory Downto 1 do
  335.   BEGIN
  336.    For x:=1 To 3 Do
  337.     Begin
  338.      For y:=1 To 3 Do
  339.       write(GameMemory[Count,x,y],' ');
  340.      writeln
  341.     End;
  342.    writeln('Wins..', Wins[Count]);
  343.    writeln
  344.   End
  345. End;
  346.  
  347.  
  348.  
  349. Procedure InMemory(CGame: Board; Var Num, TimesWon: Word);
  350.   var TempX,TempY,x,y,Count: Word;
  351.       Match1, Match2, Match3, Match4:  Boolean;
  352.  Begin
  353.   TimesWon:=0;
  354.   Count:=1;
  355.   Repeat
  356.     Match1:=True;
  357.     Match2:=True;
  358.     Match3:=True;
  359.     Match4:=True;
  360.     For x:=1 to 3 do
  361.      For y:=1 to 3 do Begin
  362.       TempX:=x;TempY:=y;
  363.       if CGame[x,y] <> GameMemory[Count,TempX,TempY] then Match1:=False;
  364.       IF x=1 then TempX:=3;
  365.       IF x=3 then TempX:=1;
  366.       IF CGame[x,y] <> GameMemory[Count,TempX,TempY] then Match2:=False;
  367.       IF y=1 then TempY:=3;
  368.       IF y=3 then TempY:=1;
  369.       IF CGame[x,y] <> GameMemory[Count,TempX,TempY] then Match3:=False;
  370.       TempX:=x;
  371.       IF CGame[x,y] <> GameMemory[Count,TempX,TempY] then Match4:=False;
  372.      End;
  373.     If (Match1) or (Match2) or (Match3) or (Match4) Then Begin
  374.      TimesWon:=Wins[Count];
  375.      Num:=Count
  376.     End;
  377.    Count:=Count+1;
  378.   Until ((Count-1)=Num) or (TimesWon <> 0)
  379.  End;
  380.  
  381. Function FileExists(FileName: String): Boolean;
  382. var f: text;
  383. Begin
  384. {$I-}
  385.  Assign(f,FileName);
  386.  Reset(f);
  387.  Close(f);
  388. {I+}
  389.  FileExists := (IOResult = 0) and (FileName <> '');
  390. end;
  391.  
  392.  
  393.  
  394.  
  395. BEGIN
  396.  Str(TotalGameMemory, FileString);
  397.  FileString:= FileName + FileString;
  398.  GetTime(Hr,Min,sec,sec100);
  399.  Writeln(Hr,':',Min);
  400.  Randomize;
  401.  If (Not FileExists(FileString)) then
  402.  Begin
  403.   For Count:=1 to TotalGameMemory Do Begin
  404.    LastWin[Count]:=0;
  405.    Wins[Count]:=0
  406.   End;
  407.   TotalGames:=0;
  408.   Winner1:=0;
  409.   Winner2:=0;
  410.   ClearMem(GameMemory);
  411.   FileIt(GameMemory)
  412.  End;
  413.  ReadMemory(GameMemory);
  414.  DrawField;
  415.  SetFillStyle(LineFill,Red);
  416.  GameCount:=0;
  417.  Repeat
  418.   GameCount:=GameCount+1;
  419.   If (GameCount/GStep) = (GameCount div GStep) then Bar(2,200,9,200-(GameCount div GStep));
  420.   If (GameCount/SortStep) = (GameCount div SortStep) then
  421.    Begin
  422.     SortMem(GameMemory);
  423.     Purge(GameMemory)
  424.    End;
  425.   ClearMem(CurrentGameMemory);
  426.   Init;
  427.   Turn:=0;
  428.   Repeat
  429.    Turn:=Turn+1;
  430.    Player:=1;
  431.    RandMove(Player ,CurrentBoard);
  432.    Player:=2;
  433.    InMem:=False;
  434.    If (Winner(CurrentBoard)<>1) and (Open(CurrentBoard)) Then
  435.     Begin
  436.      Num:=128;
  437.      MostWins:=1;
  438.      MoveNum:=0;
  439.      For CTest:=1 To (12-(2*turn)) Do Begin
  440.       Test:=CurrentBoard;
  441.       RandMove(Player,Test);
  442.       InMemory(Test,Num,TimesWon);
  443.       If TimesWon > MostWins then Begin
  444.        MoveNum:=Num;
  445.        MostWins:=TimesWon;
  446.        InMem:=True
  447.       End
  448.      End;
  449.      Case InMem of
  450.       False:     RandMove(Player,CurrentBoard);
  451.       True:      Begin
  452.                   CurrentBoard:=GameMemory[MoveNum]
  453.                  End
  454.      End;
  455.    End;
  456.    Store(CurrentBoard, Turn);
  457.    DrawBoard(CurrentBoard, LastBoard);
  458.    LastBoard:=CurrentBoard;
  459.    Checker:=Winner(CurrentBoard)
  460.   Until (Checker<>0) or (Not Open(CurrentBoard));
  461.   Case Checker of
  462.     1: Begin
  463.         Memry(CurrentGameMemory, Turn, -1);
  464.         Winner1:=Winner1+1
  465.        End;
  466.     2: Begin
  467.         Memry(CurrentGameMemory, Turn, 1);
  468.         Winner2:=Winner2+1
  469.        End
  470.    End
  471.  Until (GameCount=Games) or (KeyPressed);
  472.  GetTime(EHr,EMin,sec,sec100);
  473.  CloseGraph;
  474.  If Ehr<hr then Ehr:=Ehr+24;
  475.  ph:=Ehr-hr;
  476.  pm:=emin-min;
  477.  pm:=(ph*60)+pm;
  478.  Writeln('I Played ',GameCount,' Games In ',pm,' Minutes.');
  479.  If Pm <> 0 Then Writeln('I Averaged ',GameCount div pm,' Games a minute.');
  480.  SortMem(GameMemory);
  481.  Purge(GameMemory);
  482.  Writeln('My Opponent Has Won ',Winner1,' Games.');
  483.  Writeln('I Have Won ',Winner2,' Games.');
  484.  Writeln('I Have Played a Total of ', TotalGames + GameCount,' Games.');
  485.  Writeln('I Have Won ',trunc((Winner2)/(TotalGames + GameCount)*100),'% of the Games.');
  486.  Writeln('My Opponent Has won ',trunc((Winner1)/(totalGames + GameCount)*100),'% of the Games.');
  487.  FileIt(GameMemory);
  488.  Readln
  489. END.